perm filename BASIC.LSP[206,JMC]3 blob sn#075776 filedate 1973-12-05 generic text, type T, neo UTF8

(DEFPROP BASICFNS
 (BASICFNS ORLIS
	   ANDLIS
	   MAPCAR2
	   MAPCHOOSE
	   MAPAPP
	   PRUP
	   LISTSUBT
	   LISTSUBTA
	   CONTAINED
	   DELETE
	   PICKOUT
	   PICKOUTA)
VALUE)

(DEFPROP ORLIS
 (LAMBDA(PRED U)
  (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)

(DEFPROP ANDLIS
 (LAMBDA(PRED U)
  (OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
EXPR)

(DEFPROP MAPCAR2
 (LAMBDA(FN U V)
  (COND	((NULL U) NIL)
	(T
	 (CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
EXPR)

(DEFPROP MAPCHOOSE
 (LAMBDA(PRED FN U)
  (COND	((NULL U) NIL)
	((PRED (CAR U))
	 (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
	(T (MAPCHOOSE PRED FN (CDR U)))))
EXPR)

(DEFPROP MAPAPP
 (LAMBDA(FN U)
  (COND	((NULL U) NIL)
	(T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
EXPR)

(DEFPROP PRUP
 (LAMBDA(U V)
  (COND	((NULL U)
	 (COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
	((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
	(T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
EXPR)

(DEFPROP LISTSUBT
 (LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
EXPR)

(DEFPROP LISTSUBTA
 (LAMBDA(U N Z)
  (COND	((EQUAL N 0) Z)
	(T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
EXPR)

(DEFPROP CONTAINED
 (LAMBDA(U V)
  (OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
EXPR)

(DEFPROP DELETE
 (LAMBDA(X U)
  (COND	((NULL U) NIL)
	((EQUAL X (CAR U)) (CDR U))
	(T (CONS (CAR U) (DELETE X (CDR U))))))
EXPR)

(DEFPROP PICKOUT
 (LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
EXPR)

(DEFPROP PICKOUTA
 (LAMBDA(PRED U X Y)
  (COND	((NULL U) (CONS X Y))
	((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
	(T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
EXPR)